home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 031-040 / amok33 / portprint / portprint.mod < prev    next >
Text File  |  1993-11-04  |  2KB  |  74 lines
  1. (* -------------------------------------------------------------------------
  2.   :Program.       PortPrint
  3.   :Author.        Kai Bolay
  4.   :Address.       Hoffmannstraße 168, 7250 Leonberg
  5.   :Phone.         07152/22135
  6.   :History.       v1.0 Initial
  7.   :Copyright.     Freeware (maybe a claim by Markt & Technik)
  8.   :Language.      Modula-2
  9.   :Translator.    M2Amiga 3.3d
  10.   :Contents.      PortPrint's main output Program
  11. ------------------------------------------------------------------------- *)
  12. MODULE PortPrint;
  13.  
  14. FROM SYSTEM      IMPORT ADR;
  15. FROM Terminal    IMPORT WriteString, WriteLn, waitCloseGadget;
  16. FROM Str         IMPORT Length, Compare;
  17. FROM Arts        IMPORT Assert, DetectCtrlC;
  18. FROM Exec        IMPORT FindPort, MsgPortPtr, WaitPort, GetMsg, MessagePtr,
  19.                         FreeMem, Message, Forbid, Permit;
  20. FROM ExecSupport IMPORT CreatePort, DeletePort;
  21. FROM PortInOut   IMPORT PortName, SendText;
  22.  
  23. CONST Copyright = "This is PortPrint by K. Bolay (Idea: Achim Albert)";
  24.       Install   = "PortPrint installed!";
  25.       Remove    = "PortPrint removed";
  26.       Quit      = "!¡!QUIT!¡!";
  27.  
  28. VAR PortPtr : MsgPortPtr;
  29.     MsgPtr  : MessagePtr;
  30.     TextPtr : POINTER TO ARRAY [0..999] OF CHAR;
  31.  
  32. BEGIN
  33.    DetectCtrlC (FALSE);
  34.    WriteString (Copyright); WriteLn;
  35.    Forbid;
  36.    PortPtr := FindPort (ADR (PortName));
  37.    IF PortPtr = NIL THEN
  38.       PortPtr := CreatePort (ADR (PortName), 0);
  39.       Permit;
  40.       Assert (PortPtr # NIL, ADR ("Can't create Port!"));
  41.       waitCloseGadget := FALSE;
  42.       WriteString (Install); WriteLn;
  43.       LOOP
  44.          WaitPort (PortPtr);
  45.          MsgPtr := GetMsg (PortPtr);
  46.          IF MsgPtr # NIL THEN
  47.             TextPtr := MsgPtr^.node.name;
  48.             IF TextPtr # NIL THEN
  49.                Forbid;
  50.                IF Compare (TextPtr^, Quit) = 0 THEN
  51.                   DeletePort (PortPtr);
  52.                   Permit;
  53.                   PortPtr := NIL;
  54.                   FreeMem (TextPtr, Length (TextPtr^) + 1);
  55.                   FreeMem (MsgPtr, SIZE (Message));
  56.                   EXIT;
  57.                ELSE
  58.                   Permit;
  59.                   WriteString (TextPtr^);
  60.                   FreeMem (TextPtr, Length (TextPtr^) + 1);
  61.                   FreeMem (MsgPtr, SIZE (Message));
  62.                END; (* IF *)
  63.             END; (* IF *)
  64.             WriteLn;
  65.             MsgPtr := NIL;
  66.          END; (* IF *)
  67.       END; (* LOOP *)
  68.    ELSE
  69.       Permit;
  70.       SendText (Quit);
  71.       WriteString (Remove); WriteLn;
  72.    END; (* IF *)
  73. END PortPrint.
  74.